home *** CD-ROM | disk | FTP | other *** search
/ BCI NET / BCI NET Dec 94.iso / archives / programming / languages / f77-1.4.lha / f77 / src.lha / src / f77.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-10-26  |  9.1 KB  |  438 lines
  1. /*
  2.  * Front end for AT&T f2c - SAS/C combo.
  3.  *
  4.  * Copyright (c) 1994 Torsten Poulin
  5.  * torsten@diku.dk
  6.  *
  7.  * $Id: f77.c 1.4 1994/10/26 01:37:13 torsten Rel $
  8.  * $Log: f77.c $
  9.  * Revision 1.4  1994/10/26  01:37:13  torsten
  10.  * Added NOOPTSIZE OPTTIME switches to sc cmdline when using -O.
  11.  * Fixed a minor bug in the handling of spawn() return code in f2c().
  12.  * Removed tmp file stuff from f2c() as it caused more problems
  13.  * than it was worth, like defeating the purpose of #line directives;
  14.  * this made the third argument to cc() superfluous, so it was removed, too.
  15.  *
  16.  * Revision 1.3  1994/10/21  14:53:47  torsten
  17.  * Added NOERRSRC to sc invokation.
  18.  * Changed -U option to +U (old form still accepted, though).
  19.  * Added -noext switch to disable extensions to Fortran 77.
  20.  * Filenames longer than 128 chars will be rejected to avoid
  21.  * overflowing the buffer used when spawning subprocesses.
  22.  *
  23.  * Revision 1.2  1994/10/20  10:11:37  torsten
  24.  * Moved redirection in f2c invokation to make things DOS 1.x compatible.
  25.  *
  26.  * Revision 1.1  1994/10/20  09:53:41  torsten
  27.  * Initial revision
  28.  *
  29.  */
  30.  
  31. #include <stdio.h>
  32. #include <stdlib.h>
  33. #include <string.h>
  34. #include <stdarg.h>
  35. #include <unistd.h>
  36.  
  37.  
  38. static const char RCS[] = "$Id: f77.c 1.4 1994/10/26 01:37:13 torsten Rel $";
  39.  
  40. struct objfile {
  41.   struct objfile *next;
  42.   int keep;
  43.   char name[1];
  44. };
  45.  
  46. struct filename {
  47.   struct filename *next;
  48.   char name[1];
  49. };
  50.  
  51.  
  52. void usage(void);
  53. void filename(char *);
  54. void f2c(char *, char *);
  55. void cc(char *, char *);
  56. void obj(char *, char *, int);
  57. void lib(char *, char *);
  58. void llib(char *);
  59. void linker(void);
  60. int  spawn(char *, ...);
  61. char *xstrdup(char *);
  62. void *xmalloc(size_t);
  63. void xmktemp(char *, char *);
  64. void banner(void);
  65.  
  66. struct objfile *objects, *lastobj;
  67. struct filename *names, *lastname;
  68. struct filename *llibs, *lastllib;
  69. struct filename *libs, *lastlib;
  70. char *cmdline, *outputname;
  71.  
  72. int verbose, rangecheck, shortint, longint;
  73. int honourcase, implnone, nowarn, nowarn66, onetrip;
  74. int nolink, nocompile, optimize, debug, backslash, noext;
  75.  
  76.  
  77. int main(int argc, char **argv)
  78. {
  79.   struct filename *nptr;
  80.   int error = 0;
  81.  
  82.   if (argc == 1) usage();
  83.  
  84.   cmdline = xmalloc(512);
  85.   outputname = "a.out";
  86.  
  87.   while (--argc && !error) {
  88.     ++argv;
  89.     if (**argv == '-') {
  90.       switch (argv[0][1]) {
  91.       case 'C': rangecheck = 1; break;
  92.       case 'I':
  93.     if (argv[0][2] == '2' && !longint) shortint = 1;
  94.     else if (argv[0][2] == '4' && !shortint) longint = 1;
  95.     else error = 1;
  96.     break;
  97.       case 'u': implnone = 1; break;
  98.       case 'w': 
  99.     if (!argv[0][2] && !nowarn66) nowarn = 1;
  100.     else if (strcmp(*argv, "-w66") == 0 && !nowarn) nowarn66 = 1;
  101.     else error = 1;
  102.     break;
  103.       case 'o':
  104.     if (strcmp(*argv, "-onetrip") == 0) onetrip = 1;
  105.     else if (!argv[0][2]) {
  106.       ++argv; --argc;
  107.       outputname = xstrdup(*argv);
  108.     }
  109.     else outputname = xstrdup(&argv[0][2]);
  110.     break;
  111.       case 'l':
  112.     if (!argv[0][2]) {
  113.       ++argv; --argc;
  114.       llib(*argv);
  115.     }
  116.     else llib(&argv[0][2]);
  117.     break;
  118.       case 'n':
  119.         if (strcmp(*argv, "-noext") == 0) noext = 1;
  120.         else error = 1;
  121.         break;
  122.       case 'v': verbose = 1; break;
  123.       case 'c': nolink = 1; break;
  124.       case 'S': nocompile = nolink = 1; break;
  125.       case 'O': optimize = 1; break;
  126.       case 'g': debug = 1; break;
  127.       case 'U': honourcase = 1; break;
  128.       default: error = 1;
  129.       }
  130.     }
  131.     else if (**argv == '+') {
  132.       switch (argv[0][1]) {
  133.       case 'B': backslash = 1; break;
  134.       case 'U': honourcase = 1; break;
  135.       default:
  136.         error = 1;
  137.       }
  138.     }
  139.     else {
  140.       /*
  141.        * A name. Store it ...
  142.        */
  143.       if (strlen(*argv) > 128) {
  144.         fprintf(stderr, "Name \"%s\" too long for f77\n", *argv);
  145.         exit(2);
  146.       }
  147.       nptr = xmalloc(sizeof(struct filename) + strlen(*argv));
  148.       nptr->next = NULL;
  149.       strcpy(nptr->name, *argv);
  150.       if (lastname) lastname->next = nptr;
  151.       else names = nptr;
  152.       lastname = nptr;
  153.     }
  154.   }
  155.  
  156.   if (!error) {
  157.     if (verbose) banner();
  158.     for (nptr = names; nptr; nptr = nptr->next)
  159.       filename(nptr->name);
  160.   }
  161.   else usage();
  162.  
  163.   if (!nolink) linker();
  164.  
  165.   for (; objects; objects = objects->next)
  166.     if (!objects->keep) {
  167.       strcpy(cmdline, objects->name);
  168.       strcat(cmdline, ".o");
  169.       remove(cmdline);
  170.     }
  171.  
  172.   exit(0);
  173. }
  174.  
  175.  
  176. void usage(void)
  177. {
  178.   banner();
  179.   fprintf(stderr, "Usage: f77 [options] file ...\n");
  180.   exit(1);
  181. }
  182.  
  183.  
  184. void filename(char *s)
  185. {
  186.   char *path, *name, *ext;
  187.  
  188.   path = xstrdup(s);
  189.   if (name = strrchr(s, '/')) {
  190.     *name++ = '\0';
  191.     *(strrchr(path, '/') + 1) = '\0';
  192.   }
  193.   else if (name = strrchr(s, ':')) {
  194.     *name++ = '\0';
  195.     *(strrchr(path, ':') + 1) = '\0';
  196.   }
  197.   else {
  198.     *path = '\0';        /* no path part */
  199.     name = s;
  200.   }
  201.  
  202.   if (ext = strrchr(name, '.')) *ext++ = '\0';
  203.   else ext = "";
  204.  
  205.   if (strcmp(ext, "f") == 0) f2c(path, name);
  206.   else if (strcmp(ext, "c") == 0) {
  207.     if (!nocompile) cc(path, name);
  208.   }
  209.   else if (strcmp(ext, "o") == 0) obj(path, name, 1);
  210.   else if (strcmp(ext, "lib") == 0) lib(path, name);
  211.   else {
  212.     fprintf(stderr, "name must end with .f, .c, or .lib\n");
  213.     exit(1);
  214.   }
  215.  
  216.   free(path);
  217. }
  218.  
  219.  
  220. /*
  221.  * Invoke 'f2c' on a FORTRAN source file.
  222.  * If the nocompile flag is unset, compile the
  223.  * resulting C source.
  224.  */
  225.  
  226. void f2c(char *path, char *name)
  227. {
  228.   int result = 0;
  229.  
  230.   result = spawn("f2c -A -g%s%s%s%s%s%s%s%s \"%s%s.f\"",
  231.          (rangecheck ? " -C" : ""),
  232.          (shortint ? " -I2" : (longint ? " -I4" : "")),
  233.          (honourcase ? " -U" : ""),
  234.          (implnone ? " -u" : ""),
  235.          (nowarn ? " -w" : (nowarn66 ? " -w66" : "")),
  236.          (onetrip ? " -onetrip" : ""),
  237.          (backslash ? "" : " -!bs"),
  238.                  (noext ? " -ext" : ""),
  239.          path, name);
  240.   if (!nocompile) {
  241.     if (result == 0) cc(path, name);
  242.     sprintf(cmdline, "%s%s.c", path, name);
  243.     remove(cmdline);
  244.   }
  245.   if (result) exit(1);
  246. }
  247.  
  248.  
  249. /*
  250.  * Invoke C compiler (SAS/C)
  251.  */
  252.  
  253. void cc(char *path, char *name)
  254. {
  255.   if (spawn("sc noicons ign=154,161 nover \"%s%s.c\" objname \"%s.o\""
  256.          "%s%s%s data=far code=far math=s noerrsrc",
  257.          path, name, name,
  258.          (verbose ? " verbose" : ""),
  259.          (optimize ? " opt nooptsize opttime" : " noopt"),
  260.          (debug ? " dbg=sf" : " nodbg")))
  261.     exit(1);
  262.   obj("", name, nolink);
  263. }
  264.  
  265.  
  266. /*
  267.  * Queue an object file for later linking.
  268.  */
  269.  
  270. void obj(char *path, char *name, int keep)
  271. {
  272.   struct objfile *new;
  273.  
  274.   new = xmalloc(sizeof(struct objfile) + strlen(path) + strlen(name));
  275.  
  276.   new->next = NULL;
  277.   new->keep = keep;
  278.   strcpy(new->name, path);
  279.   strcat(new->name, name);
  280.   if (lastobj) lastobj->next = new;
  281.   else objects = new;
  282.   lastobj = new;
  283. }
  284.  
  285.  
  286. void lib(char *path, char *name)
  287. {
  288.   struct filename *new;
  289.  
  290.   new = xmalloc(sizeof(struct filename) + strlen(path) + strlen(name));
  291.  
  292.   new->next = NULL;
  293.   strcpy(new->name, path);
  294.   strcat(new->name, name);
  295.   if (lastlib) lastlib->next = new;
  296.   else libs = new;
  297.   libs = new;
  298. }
  299.  
  300.  
  301. void llib(char *name)
  302. {
  303.   struct filename *new;
  304.  
  305.   new = xmalloc(sizeof(struct filename) + strlen(name));
  306.  
  307.   new->next = NULL;
  308.   strcpy(new->name, name);
  309.   if (lastllib) lastllib->next = new;
  310.   else llibs = new;
  311.   llibs = new;
  312. }
  313.  
  314.  
  315. void linker(void)
  316. {
  317.   struct objfile *of;
  318.   FILE *wfile;
  319.   char with[13];
  320.  
  321.   xmktemp(with, "lnk_XXXXXXXX");
  322.  
  323.   if (!(wfile = fopen(with, "w"))) {
  324.     fprintf(stderr, "Unable to create temporary file\n");
  325.     exit(2);
  326.   }
  327.  
  328.   if (verbose) fprintf(stderr, "==> %s:\n", with);
  329.  
  330.   fprintf(wfile, "lib:c.o\n");
  331.   if (verbose) fprintf(stderr, "\tlib:c.o\n");
  332.  
  333.   /*
  334.    * Write the list of object files
  335.    */
  336.   for (of = objects; of; of = of->next) {
  337.     fprintf(wfile, "\"%s.o\"\n", of->name);
  338.     if (verbose) fprintf(stderr, "\t\"%s.o\"\n", of->name);
  339.   }
  340.  
  341.   /*
  342.    * Write the list of libraries
  343.    */
  344.   for (; llibs; llibs = llibs->next) {
  345.     fprintf(wfile, "lib \"lib:%s.lib\"\n", llibs->name);
  346.     if (verbose) fprintf(stderr, "\tlib \"lib:%s.lib\"\n", llibs->name);
  347.   }
  348.   for (; libs; libs = libs->next) {
  349.     fprintf(wfile, "lib \"%s.lib\"\n", libs->name);
  350.     if (verbose) fprintf(stderr, "\tlib \"%s.lib\"\n", libs->name);
  351.   }
  352.  
  353.   fprintf(wfile, "lib lib:f2c.lib lib:scmnb.lib lib:scnb.lib\n");
  354.   if (verbose) 
  355.     fprintf(stderr, "\tlib lib:f2c.lib lib:scmnb.lib lib:scnb.lib\n");
  356.  
  357.   if (debug) {
  358.     fprintf(wfile, "addsym\n");
  359.     if (verbose) fprintf(stderr, "\taddsym\n");
  360.   }
  361.   else {
  362.     fprintf(wfile, "nd\n");
  363.     if (verbose) fprintf(stderr, "\tnd\n");
  364.   }
  365.  
  366.   fclose(wfile);
  367.   spawn("slink to \"%s\" noicons batch with %s %s",
  368.     outputname, with, (verbose ? "verbose" : "quiet"));
  369.   remove(with);
  370. }
  371.  
  372.  
  373. /*
  374.  * Execute a subcommand.
  375.  */
  376.  
  377. int spawn(char *fmt, ...)
  378. {
  379.   va_list ap;
  380.  
  381.   va_start(ap, fmt);
  382.   vsprintf(cmdline, fmt, ap);
  383.   va_end(ap);
  384.  
  385.   if (verbose) {
  386.     fprintf(stderr, "%s\n", cmdline);
  387.     fflush(stderr);
  388.   }
  389.  
  390.   return system(cmdline);
  391. }
  392.  
  393.  
  394. void *xmalloc(size_t n)
  395. {
  396.   void *mem;
  397.  
  398.   if (!(mem = malloc(n))) {
  399.     fprintf(stderr, "insufficient memory\n");
  400.     exit(2);
  401.   }
  402.   return mem;
  403. }
  404.  
  405.  
  406. char *xstrdup(char *s)
  407. {
  408.   char *new;
  409.  
  410.   new = xmalloc(strlen(s) + 1);
  411.   strcpy(new, s);
  412.   return new;
  413. }
  414.  
  415.  
  416. /*
  417.  * Make a temporary filename.
  418.  */
  419.  
  420. void xmktemp(char *t, char *templ)
  421. {
  422.   strcpy(t, templ);
  423.   mktemp(t);
  424.   if (!*t) {
  425.     fprintf(stderr, "Cannot make temporary filename\n");
  426.     exit(2);
  427.   }
  428. }
  429.  
  430.  
  431. void banner(void)
  432. {
  433.   fprintf(stderr,
  434.       "\2331mf77 style frontend for f2c. "
  435.       "Copyright (C) 1994 Torsten Poulin\2330m\n");
  436. }
  437.  
  438.